home *** CD-ROM | disk | FTP | other *** search
Text File | 1986-07-17 | 54.1 KB | 1,403 lines | [TEXT/ttxt] |
- $LINESIZE: 132
- $PAGESIZE: 61
- $STORAGE: 2
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C M I C R O S A F E C
- C Structural Analysis by Finite Elements C
- C Module : SAFESOLV, 1st Part C
- C Version : 2-D C
- C C
- C COPYRIGHT (C) by MICROSTRESS Corporation - 1985,1986 C
- C ALL RIGHTS RESERVED C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- PROGRAM safesolv
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C TYPE SPECIFICATION C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- INTEGER ppmuqq,ofnflg,echflg,scrflg,ascstr,longi*4,longj*4,
- + longk*4,longl*4,ddrive,odrive,previd,memava*4,numele*4
- DOUBLE PRECISION invqcn,stmtrx,stmqcn,disdof,beamcf,ftcons,pthick,
- + eyoung,pratio,diffnc,blngth,bmlcos,bmlsin,appldf,
- + ratio,sttemp,th
- CHARACTER inpfil*78,outfil*78,toufil*78,txtdisp*24,comand*127,
- + space*2,string*5,datext*11,timtxt*12,intgst*25,dash*1,
- + prompt*56,diamsg*110,reaclb*8,arrow*1,elipss*4,
- + blank*1,ifdriv*6,ifpath*64,ifname*9,ifextn*5,flspec*78,
- + ofdriv*6,ofpath*64,ofname*9,ofextn*5,toextn*5
- LOGICAL ffound
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C ARRAY DIMENSIONING C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- DIMENSION invqcn(2,2),ftcons(9),diffnc(2,4),txtdisp(3),plints(3),
- + baxial(600),bshear(2,600),bmomnt(2,600),inp(3),entry(8),
- + sttemp(8,2),reaclb(3),youngm(20),poisson(20),
- + lenhbw(1200),nodst3(400),igndof(1200),beamcf(3,3),
- + mxndif(400),nodebm(2,600),bmarea(600),bminer(600),
- + matcbm(600),bmdis1(600),bmdis2(600),plteth(500),
- + matcpl(500),nodefs(2,60),fsarea(60),fsstif(60),
- + nodepl(4,500)
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C COMMON SPECIFICATION C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- COMMON /global/ numdof,stmqcn(2,2)
- common /sizebw/ malhbw
- COMMON /plates/ disdof(1203),pltecf(2,4),plstrs(3,500),
- + reafor(3,400),pstnor(3,400),pstacc(3,400)
- COMMON /aaaaaa/ stmtrx(8200)
- common /filenm/ inpfil,outfil
- common /forces/ appldf(1200)
- COMMON /dskrom/ scrflg,odrive
- common /coordi/ coonod(2,401)
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C USER DEFINED FUNCTIONS C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- previd(k,l)=MOD(k+l-2,l)+1
- nextid(k,l)=MOD(k,l)+1
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C GENERAL INITIALIZATION C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- call time (inithr,initmn,initsc,iniths)
- call datstr (datext)
- call timstr (timtxt)
- C
- C Show copyright notice on the screen.
- C
- call logpsl
- C
- C Initialize variables.
- C
- scrflg=0
- maxban=6
- stmqcn(1,1)=0.
- stmqcn(1,2)=0.
- stmqcn(2,1)=0.
- stmqcn(2,2)=0.
- space=' '
- call setstr (2,space)
- toextn='.OUT '
- call setstr (5,toextn)
- elipss='... '
- call setstr (4,elipss)
- call defdrv (0,ddrive)
- C
- C Determine number of stiffness matrix elements which will fit in RAM.
- C
- numele=memava(stmtrx(1))/4
- if (numele .gt. 65535) numele=65535
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ THE COMMAND TAIL C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- ierror=ppmuqq (0,0,comand)
- length=ascstr (1,comand)+2
- if (length .ne. 2) then
- call setstr (127,comand)
- call endstr (length,comand)
- call movstr (comand,1,0,space,1,1)
- call upcstr (comand)
- string=' I= '
- call setstr (4,string)
- locatn=locstr (1,comand,string)+3
- if (locatn .ne. 3) then
- nxtloc=locstr (locatn,comand,space)
- if (nxtloc .eq. 0) nxtloc=length
- numchr=nxtloc-locatn
- inpfil='
- + '
- call setstr (78,inpfil)
- call movstr (inpfil,1,0,comand,locatn,numchr)
- call resstr (inpfil)
- ifnflg=1
- endif
- call modstr (string,2,79)
- locatn=locstr (1,comand,string)+3
- if (locatn .ne. 3) then
- nxtloc=locstr (locatn,comand,space)
- if (nxtloc .eq. 0) nxtloc=length
- numchr=nxtloc-locatn
- outfil='
- + '
- call setstr (78,outfil)
- call movstr (outfil,1,0,comand,locatn,numchr)
- call resstr (outfil)
- ofnflg=1
- endif
- string=' E '
- call setstr (3,string)
- locatn=locstr (1,comand,string)
- if (locatn .ne. 0) echflg=1
- call modstr (string,2,83)
- locatn=locstr (1,comand,string)
- if (locatn .ne. 0) scrflg=1
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C SET INPUT AND OUTPUT FILES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- 65 if (ifnflg .eq. 0) then
- WRITE (*,70)
- 70 FORMAT (' Input data file name [.INP]? '\)
- READ (*,'(A)') inpfil
- else
- WRITE (*,72) inpfil
- 72 FORMAT (' Input data file name [.INP]: ',a78)
- endif
- flspec=inpfil
- call parsfn (flspec,ddrive,ifdriv,idrive,ifpath,ifname,ifextn)
- inpfil=flspec
- if (lenstr(ifextn) .eq. 0) then
- ifextn='.INP '
- call setstr (5,ifextn)
- call constr (inpfil,ifextn)
- endif
- call resstr (inpfil)
- inquire (FILE=inpfil,EXIST=ffound)
- if (ffound) then
- OPEN (1,FILE=inpfil)
- else
- call setstr (78,inpfil)
- call pakstr (inpfil)
- length=lenstr (inpfil)
- call expstr (inpfil)
- call resstr (inpfil)
- call wrfstr (float(length),intgst)
- length=lenstr (intgst)
- prompt='('' ERROR : File "'',a ,''" cannot be found. Try agai
- +n.'') '
- call setstr (56,prompt)
- call movstr (prompt,21,0,intgst,1,length)
- write (*,prompt) inpfil
- ifnflg=0
- goto 65
- ENDIF
- 74 toufil=inpfil
- call setstr (78,toufil)
- locatn=locstr (1,toufil,ifextn)
- call movstr (toufil,locatn,1,toextn,1,4)
- length=lenstr (toufil)
- call expstr (toufil)
- call resstr (toufil)
- call wrfstr (float(length),intgst)
- length=lenstr (intgst)
- prompt='('' Output data file name ['',a ,'']: '',a78 )
- + '
- call setstr (56,prompt)
- call movstr (prompt,30,0,intgst,1,length)
- if (ofnflg .eq. 0) then
- call modstr (prompt,35,63)
- string='\ '
- call setstr (5,string)
- call movstr (prompt,38,0,string,1,4)
- call resstr (prompt)
- WRITE (*,prompt) toufil
- READ (*,'(A)') outfil
- else
- call resstr (prompt)
- WRITE (*,prompt) toufil,outfil
- endif
- flspec=outfil
- call parsfn (flspec,idrive-1,ofdriv,odrive,ofpath,ofname,ofextn)
- outfil=flspec
- IF (lenstr(ofdriv) .le. 2) then
- call setstr (78,outfil)
- call endstr (1,outfil)
- if (lenstr(ofdriv) .eq. 0) ofdriv=ifdriv
- if (lenstr(ofpath) .eq. 0) ofpath=ifpath
- if (lenstr(ofname) .eq. 0) ofname=ifname
- if (lenstr(ofextn) .eq. 0) ofextn=toextn
- call constr (outfil,ofdriv)
- call constr (outfil,ofpath)
- call constr (outfil,ofname)
- call constr (outfil,ofextn)
- endif
- call resstr (outfil)
- call opnfil (ierror)
- if (ierror .ne. 0) then
- ofnflg=0
- goto 74
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C START THE OUTPUT FILE C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- call diskroom (0)
- C
- C Header title
- C
- call diskroom (331)
- WRITE (2,80,err=2000) datext,timtxt,inpfil,outfil
- 80 FORMAT (' M I C R O S A F E --- STRUCTURAL ANALYSIS BY FINITE EL',
- +'EMENTS',4x,'Version: SAFESOLV (2-D)',2x,'Rel. 1.0',3x,a10,1x,a8//
- +/' Input data file : ',A/' Output data file : ',A/)
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C START READING THE INPUT FILE C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- diamsg='Reading model data from file
- + '
- call setstr (110,diamsg)
- call setstr (78,inpfil)
- call movstr (diamsg,30,0,inpfil,1,77)
- call resstr (inpfil)
- call pakstr (diamsg)
- call constr (diamsg,elipss)
- call expstr (diamsg)
- call resstr (diamsg)
- call resstr (ofdriv)
- if (ofdriv .eq. 'CON: ') scrflg=-1
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE MODEL SIZE LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Size header
- C
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- WRITE (*,85)
- 85 FORMAT (/' SIZE OF THE STRUCTURE'/)
- else
- if (scrflg .eq. 0) write (*,87) diamsg
- 87 format (/1X,A/' Size...'\)
- endif
- call diskroom (30)
- WRITE (2,85,err=2000)
- else
- write (*,87) diamsg
- endif
- C
- C Number of nodes and degrees of freedom
- C
- CALL verify(1,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nnodes=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,90) nnodes
- 90 FORMAT (' Number of nodes :',I4)
- call diskroom (48)
- WRITE (2,90,err=2000) nnodes
- endif
- DO 92 loop=1,nnodes
- DO 92 indx=1,3
- reafor(indx,loop)=0.
- pstnor(indx,loop)=0.
- 92 pstacc(indx,loop)=0.
- numdof=3*nnodes
- DO 94 loop=1,numdof
- 94 appldf(loop)=0.
- malhbw=numele/numdof-2
- if (malhbw .gt. numdof) malhbw=numdof
- longj=numdof*(malhbw+2)
- do 96 longi=1,longj
- 96 stmtrx(longi)=0.
- C
- C Number of types of material
- C
- CALL verify(2,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nmater=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,98) nmater
- 98 FORMAT (' Number of materials :',I4)
- call diskroom (48)
- WRITE (2,98,err=2000) nmater
- endif
- C
- C Number of beams
- C
- CALL verify(3,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nbeams=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,100) nbeams
- 100 FORMAT (' Number of beams :',I4)
- call diskroom (48)
- WRITE (2,100,err=2000) nbeams
- endif
- C
- C Number of plates
- C
- CALL verify(4,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nplate=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,105) nplate
- 105 FORMAT (' Number of plates :',I4)
- call diskroom (48)
- WRITE (2,105,err=2000) nplate
- endif
- DO 107 loop=1,nplate
- DO 107 indx=1,3
- 107 plstrs(indx,loop)=0.
- C
- C Number of fasteners
- C
- CALL verify(5,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nfastn=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,110) nfastn
- 110 FORMAT (' Number of fasteners :',I4)
- call diskroom (48)
- WRITE (2,110,err=2000) nfastn
- endif
- C
- C Number of loaded nodes
- C
- CALL verify(6,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nlnods=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,115) nlnods
- 115 FORMAT (' Number of loaded nodes :',I4)
- call diskroom (48)
- WRITE (2,115,err=2000) nlnods
- endif
- C
- C Number of restrained degrees of freedom
- C
- CALL verify(7,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- nresdf=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,120) nresdf
- 120 FORMAT (' Number of restrained degrees of freedom :',I4)
- call diskroom (48)
- WRITE (2,120,err=2000) nresdf
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE NODE COORDINATES LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Coordinates of the nodes
- C
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- WRITE (*,125)
- 125 FORMAT (//' NODE COORDINATES'//' Node Coordinate X ',
- + 'Coordinate Y'/)
- else
- if (scrflg .eq. 0) write (*,130)
- 130 format ('Nodes...'\)
- endif
- call diskroom (68)
- WRITE (2,125,err=2000)
- else
- write (*,130)
- endif
- call chkdup (0,ierror)
- DO 160 loop=1,nnodes
- CALL verify(8,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- coonod(1,i)=entry(2)
- coonod(2,i)=entry(3)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,150) i,entry(2),entry(3)
- 150 FORMAT (I5,3X,F12.5,3X,F12.5)
- call diskroom (37)
- WRITE (2,150,err=2000) i,entry(2),entry(3)
- endif
- 160 CONTINUE
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE MATERIAL PROPERTIES LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Material properties
- C
- if (nmater .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- write (*,170)
- 170 FORMAT (//' MATERIAL PROPERTIES'//' Code Young',
- + 1H','s modulus',' Poisson',1H','s ratio'/)
- else
- if (scrflg .eq. 0) write (*,175)
- 175 format ('Materials...'\)
- endif
- call diskroom (78)
- WRITE (2,170,err=2000)
- else
- write (*,175)
- endif
- call chkdup (0,ierror)
- DO 190 loop=1,nmater
- CALL verify(9,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- youngm(i)=entry(2)
- poisson(i)=entry(3)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,180) i,entry(2),entry(3)
- 180 FORMAT (I5,5X,F11.0,8X,F8.5)
- call diskroom (39)
- WRITE (2,180,err=2000) i,entry(2),entry(3)
- endif
- 190 CONTINUE
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE BEAM LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Beams
- C
- IF (nbeams .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- write (*,200)
- 200 FORMAT (//' BEAM DATA'//' Beam I J ',
- + 'Length Area M. Inertia',
- + ' Material Distributed Loads'/)
- else
- if (scrflg .eq. 0) write (*,205)
- 205 format ('Beams...'\)
- endif
- call diskroom (114)
- WRITE (2,200,err=2000)
- else
- write (*,205)
- endif
- call chkdup (0,ierror)
- DO 220,loop=1,nbeams
- CALL verify(10,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- n1=entry(2)
- n2=entry(3)
- mat=entry(6)
- bmarea(i)=entry(4)
- matcbm(i)=mat
- eyoung=youngm(mat)
- if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
- nodebm(1,i)=n1
- nodebm(2,i)=n2
- bminer(i)=entry(5)
- bmdis1(i)=entry(7)
- bmdis2(i)=entry(8)
- mxndif(n1)=MAX(n1,n2,mxndif(n1))
- mxndif(n2)=MAX(n1,n2,mxndif(n2))
- endif
- diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
- diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
- blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+diffnc(2,2)*diffnc(2,2))
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,210) i,n1,n2,blngth,entry(4),
- + entry(5),mat,entry(7),entry(8)
- 210 FORMAT (I5,2I6,F12.3,F10.4,F14.5,5X,I3,5X,2F12.3)
- call diskroom (92)
- WRITE (2,210,err=2000) i,n1,n2,blngth,entry(4),entry(5),
- + mat,entry(7),entry(8)
- endif
- if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
- bmlcos=diffnc(1,2)/blngth
- bmlsin=diffnc(2,2)/blngth
- IF (entry(5) .NE. 0.) THEN
- nodst3(n1)=1
- nodst3(n2)=1
- ENDIF
- I3=3*n1
- I2=I3-1
- I1=I2-1
- J3=3*n2
- J2=J3-1
- J1=J2-1
- IF ((entry(7) .NE. 0.) .OR. (entry(8) .NE. 0.)) THEN
- ftcons(1)=entry(7)*blngth/6
- ftcons(2)=entry(8)*blngth/6
- ftcons(3)=ftcons(1)*blngth/30
- ftcons(4)=ftcons(2)*blngth/30
- appldf(I1)=appldf(I1)-bmlsin*(2*ftcons(1)+ftcons(2))
- appldf(I2)=appldf(I2)+bmlcos*(2*ftcons(1)+ftcons(2))
- appldf(I3)=appldf(I3)+8*ftcons(3)+7*ftcons(4)
- appldf(j1)=appldf(j1)-bmlsin*(ftcons(1)+2*ftcons(2))
- appldf(j2)=appldf(j2)+bmlcos*(ftcons(1)+2*ftcons(2))
- appldf(j3)=appldf(j3)-7*ftcons(3)-8*ftcons(4)
- ENDIF
- ftcons(1)=2*eyoung*entry(5)/blngth
- ftcons(2)=entry(4)*eyoung/blngth
- ftcons(3)=bmlsin/blngth
- ftcons(4)=bmlcos/blngth
- ftcons(5)=6*ftcons(1)*ftcons(3)*ftcons(3)+
- + bmlcos*bmlcos*ftcons(2)
- ftcons(6)=6*ftcons(1)*ftcons(3)*ftcons(4)-
- + bmlcos*bmlsin*ftcons(2)
- ftcons(7)=6*ftcons(1)*ftcons(4)*ftcons(4)+
- + bmlsin*bmlsin*ftcons(2)
- ftcons(8)=-3*ftcons(1)*ftcons(3)
- ftcons(9)=-3*ftcons(1)*ftcons(4)
- CALL assemble (I1,I1,ftcons(5),-ftcons(6),ftcons(8))
- CALL assemble (I1,j1,-ftcons(5),ftcons(6),ftcons(8))
- CALL assemble (I2,I2,ftcons(7),-ftcons(9),0.)
- CALL assemble (I2,j1,ftcons(6),-ftcons(7),-ftcons(9))
- CALL assemble (I3,I3,ftcons(1)*2,0.,0.)
- CALL assemble (I3,j1,-ftcons(8),ftcons(9),ftcons(1))
- CALL assemble (j1,j1,ftcons(5),-ftcons(6),-ftcons(8))
- CALL assemble (j2,j2,ftcons(7),ftcons(9),0.)
- CALL assemble (j3,j3,ftcons(1)*2,0.,0.)
- else
- if (scrflg .ge. 0) write (*,215) i
- 215 FORMAT (/' WARNING : The beam',I4,
- + ' has been disconnected from the model.'/)
- call diskroom (69)
- WRITE (2,215,err=2000) i
- if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
- 217 format (' '\)
- endif
- 220 CONTINUE
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE PLATE LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Plates
- C
- IF (nplate .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- write (*,240)
- 240 FORMAT (//' PLATE DATA'//' Plate I J K',
- + ' L Thickness Material'/)
- else
- if (scrflg .eq. 0) write (*,245)
- 245 format ('Plates...'\)
- endif
- call diskroom (78)
- WRITE (2,240,err=2000)
- else
- write (*,245)
- endif
- call chkdup (0,ierror)
- DO 360,loop=1,nplate
- CALL verify(11,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- n1=entry(2)
- n2=entry(3)
- n3=entry(4)
- n4=entry(5)
- pthick=entry(6)
- mat=entry(7)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,250) i,N1,n2,N3,N4,pthick,mat
- 250 FORMAT (I5,4I6,F11.5,5X,I3)
- call diskroom (50)
- WRITE (2,250,err=2000) i,N1,n2,N3,N4,pthick,mat
- endif
- plteth(i)=entry(6)
- matcpl(i)=mat
- eyoung=youngm(mat)
- if ((pthick .ne. 0.) .and. (eyoung .ne. 0.)) then
- pratio=poisson(mat)
- indx=MAX(n1,n2,n3,n4)
- mxndif(n1)=MAX(mxndif(N1),indx)
- mxndif(n2)=MAX(mxndif(N2),indx)
- mxndif(n3)=MAX(mxndif(N3),indx)
- IF (n4 .GT. 0) mxndif(N4)=MAX(mxndif(N4),indx)
- diffnc(1,2)=coonod(1,N2)-coonod(1,N1)
- diffnc(2,2)=coonod(2,N2)-coonod(2,N1)
- diffnc(1,3)=coonod(1,N3)-coonod(1,N2)
- diffnc(2,3)=coonod(2,N3)-coonod(2,N2)
- IF (N4 .EQ. 0) THEN
- diffnc(1,1)=coonod(1,N1)-coonod(1,N3)
- diffnc(2,1)=coonod(2,N1)-coonod(2,N3)
- ELSE
- diffnc(1,4)=coonod(1,N4)-coonod(1,N3)
- diffnc(2,4)=coonod(2,N4)-coonod(2,N3)
- diffnc(1,1)=coonod(1,N1)-coonod(1,N4)
- diffnc(2,1)=coonod(2,N1)-coonod(2,N4)
- ENDIF
- INDX=1
- IF (diffnc(1,2)*diffnc(2,3) .GT. diffnc(2,2)*diffnc(1,3))
- + INDX=INDX+4
- IF (N4 .EQ. 0) THEN
- IF (INDX .EQ. 1) THEN
- n=n2
- n2=n3
- n3=n
- ENDIF
- ELSE
- IF (diffnc(1,3)*diffnc(2,4) .GT.
- + diffnc(2,3)*diffnc(1,4)) INDX=INDX+2
- IF (diffnc(1,4)*diffnc(2,1) .GT.
- + diffnc(2,4)*diffnc(1,1)) INDX=INDX+1
- GOTO (260,270,280,300,310,280,300,320) indx
- 260 n=n2
- n2=n4
- n4=n
- GOTO 320
- 270 n=n2
- n2=n3
- n3=n
- GOTO 320
- 280 WRITE (*,290) i
- 290 FORMAT (' ERROR : ILLEGAL NODE DECLARATION FOR ',
- + 'PLATE',I4,'.')
- call diskroom (50)
- WRITE (2,290,err=2000) i
- goto 994
- 300 n=n2
- n2=n3
- n3=n4
- n4=n
- GOTO 320
- 310 n=n3
- n3=n4
- n4=n
- 320 CONTINUE
- ENDIF
- nodepl(1,i)=N1
- nodepl(2,i)=N2
- nodepl(3,i)=N3
- nodepl(4,i)=N4
- IF (N4 .EQ. 0) THEN
- CALL triasemb (N1,N2,N3,pthick,eyoung,pratio)
- ELSE
- coonod(1,nnodes+1)=(coonod(1,N1)+coonod(1,N2)+
- + coonod(1,N3)+coonod(1,N4))/4
- coonod(2,nnodes+1)=(coonod(2,N1)+coonod(2,N2)+
- + coonod(2,N3)+coonod(2,N4))/4
- CALL triasemb (N1,N2,nnodes+1,pthick,eyoung,pratio)
- CALL triasemb (N2,N3,nnodes+1,pthick,eyoung,pratio)
- CALL triasemb (N3,N4,nnodes+1,pthick,eyoung,pratio)
- CALL triasemb (N4,N1,nnodes+1,pthick,eyoung,pratio)
- ftcons(1)=stmqcn(1,1)*stmqcn(2,2)-
- + stmqcn(1,2)*stmqcn(2,1)
- invqcn(1,1)=stmqcn(2,2)/ftcons(1)
- invqcn(2,2)=stmqcn(1,1)/ftcons(1)
- invqcn(1,2)=-stmqcn(1,2)/ftcons(1)
- invqcn(2,1)=invqcn(1,2)
- DO 330 NI=1,4
- DO 330 MI=1,2
- n=(nodepl(NI,i)-1)*3+MI
- DO 330 NJ=NI,4
- IF (NJ .EQ. NI) THEN
- MK=MI
- ELSE
- MK=1
- ENDIF
- DO 330 mj=MK,2
- J=(nodepl(NJ,i)-1)*3+MJ
- k=min(n,j)
- l=max(n,j)-k+1
- longk=(malhbw+2)*(k-1)+l
- do 332 m=1,2
- longi=(malhbw+2)*(n-1)+malhbw+m
- ftcons(2)=0.
- do 331 mm=1,2
- longj=(malhbw+2)*(j-1)+malhbw+mm
- 331 ftcons(2)=ftcons(2)+stmtrx(longj)*invqcn(m,mm)
- 332 stmtrx(longk)=stmtrx(longk)-ftcons(2)*stmtrx(longi)
- 330 CONTINUE
- DO 350 NI=1,2
- DO 340 M=1,4
- DO 340 MI=1,2
- longi=(malhbw+2)*((nodepl(M,i)-1)*3+MI)+ni-2
- stmtrx(longi)=0.
- 340 CONTINUE
- DO 345 MI=1,2
- 345 stmqcn(mi,ni)=0.
- 350 CONTINUE
- ENDIF
- else
- if (scrflg .ge. 0) write (*,355) i
- 355 FORMAT (/' WARNING : The plate',I4,
- + ' has been disconnected from the model.'/)
- call diskroom (70)
- WRITE (2,355,err=2000) i
- if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
- endif
- 360 CONTINUE
- endif
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE FASTENER LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Fasteners
- C
- IF (nfastn .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- WRITE (*,380)
- 380 FORMAT (//' FASTENER DATA'//
- + ' Fastener I J Area Stiffness'/)
- else
- if (scrflg .eq. 0) write (*,385)
- 385 format ('Fasteners...'\)
- endif
- call diskroom (70)
- WRITE (2,380,err=2000)
- else
- write (*,385)
- endif
- call chkdup (0,ierror)
- DO 400 loop=1,nfastn
- CALL verify(12,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- n1=entry(2)
- n2=entry(3)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,390) i,n1,n2,entry(4),entry(5)
- 390 FORMAT (I5,2I6,F12.6,F11.0)
- call diskroom (42)
- WRITE (2,390,err=2000) i,n1,n2,entry(4),entry(5)
- endif
- fsstif(i)=entry(5)
- if (entry(5) .ne. 0.) then
- ftcons(1)=entry(5)
- nodefs(1,i)=n1
- nodefs(2,i)=n2
- fsarea(i)=entry(4)
- I1=3*n1-2
- I2=I1+1
- J1=3*n2-2
- J2=J1+1
- mxndif(n1)=MAX(n1,n2,mxndif(n1))
- mxndif(n2)=MAX(n1,n2,mxndif(n2))
- CALL assemble (I1,I1,ftcons(1),0.,0.)
- CALL assemble (I1,j1,-ftcons(1),0.,0.)
- CALL assemble (I2,I2,ftcons(1),0.,0.)
- CALL assemble (I2,j2,-ftcons(1),0.,0.)
- CALL assemble (j1,j1,ftcons(1),0.,0.)
- CALL assemble (j2,j2,ftcons(1),0.,0.)
- else
- if (scrflg .ge. 0) write (*,395) i
- 395 FORMAT (/' WARNING : The fastener',I4,
- + ' has been disconnected from the model.'/)
- call diskroom (73)
- WRITE (2,395,err=2000) i
- if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
- endif
- 400 CONTINUE
- endif
- C
- C Fix unstiffened degrees of freedom
- C
- DO 470 loop=1,nnodes
- N1=3*loop-2
- IF (nodst3(loop) .ne. 1) then
- IF (mxndif(loop) .EQ. 0) THEN
- if (scrflg .ge. 0) write (*,465) loop
- 465 FORMAT (/' WARNING : The node',I4,
- + ' is not connected to any element in the model.'/)
- call diskroom (77)
- WRITE (2,465,err=2000) loop
- if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
- igndof(n1)=1
- disdof(n1)=0.
- igndof(n1+1)=1
- disdof(n1+1)=0.
- ENDIF
- igndof(N1+2)=1
- disdof(N1+2)=0.
- endif
- 470 CONTINUE
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE NODE LOADS LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Node loads
- C
- IF (nlnods .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- WRITE (*,410)
- 410 FORMAT (//' NODE LOADS'//' Node PX',
- + ' PY MZ'/)
- else
- if (scrflg .eq. 0) write (*,415)
- 415 format ('Loads...'\)
- endif
- call diskroom (75)
- WRITE (2,410,err=2000)
- else
- write (*,415)
- endif
- call chkdup (0,ierror)
- DO 450 loop=1,nlnods
- CALL verify(13,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,440) i,entry(2),entry(3),
- + entry(4)
- 440 FORMAT (I5,1X,3F14.2)
- call diskroom (50)
- WRITE (2,440,err=2000) i,entry(2),entry(3),entry(4)
- endif
- N1=3*i-3
- DO 445 j=1,3
- appldf(N1+J)=appldf(N1+J)+entry(j+1)
- 445 reafor(J,i)=reafor(J,i)-entry(j+1)
- 450 CONTINUE
- endif
- C
- C Initialize displacements
- C
- DO 460 loop=1,numdof
- 460 disdof(loop)=appldf(loop)
- C
- C Determine last non-zero element in each row
- C
- i=0
- JHB=6
- DO 480 loop=1,nnodes
- J=3*(mxndif(loop)-loop+1)
- IF (J .LT. JHB) THEN
- J=JHB
- ELSE
- JHB=J
- ENDIF
- DO 480 K=1,3
- i=i+1
- lenhbw(i)=min(j,numdof-i+1)
- j=j-1
- 480 CONTINUE
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C READ AND PROCESS THE NODE RESTRAINTS LINES C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Fixed displacements
- C
- IF (nresdf .gt. 0) then
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) then
- WRITE (*,490)
- 490 FORMAT (//' MOVEMENT RESTRAINTS'//' Node ',
- + 'Type of restraint Displacement'/)
- else
- if (scrflg .eq. 0) write (*,495)
- 495 format ('Restraints...'\)
- endif
- call diskroom (90)
- WRITE (2,490,err=2000)
- else
- write (*,495)
- endif
- call chkdup (0,ierror)
- txtdisp(1)='Translation along X axis'
- txtdisp(2)='Translation along Y axis'
- txtdisp(3)=' Rotation about Z axis '
- DO 510 loop=1,nresdf
- CALL verify(14,entry,ierror,maxban,youngm)
- IF (ierror .NE. 0) GOTO 994
- i=entry(1)
- indxfd=entry(2)
- if (echflg .eq. 1) then
- if (scrflg .eq. 1) WRITE (*,500) i,txtdisp(indxfd),
- + entry(3)
- 500 FORMAT (I5,8X,A24,F15.5)
- call diskroom (54)
- WRITE (2,500,err=2000) i,txtdisp(indxfd),entry(3)
- endif
- N1=3*(i-1)+indxfd
- disdof(N1)=entry(3)
- IF (entry(3) .EQ. 0.) THEN
- igndof(N1)=2
- ELSE
- longi=(malhbw+2)*(n1-1)+1
- stmtrx(longi)=1D30
- disdof(N1)=stmtrx(longi)*entry(3)
- igndof(N1)=-2
- ENDIF
- 510 CONTINUE
- endif
- CLOSE (1)
- if ((echflg .eq. 0) .or. (scrflg .eq. 0)) WRITE (*,512)
- 512 format ('End')
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C SOLVE THE SYSTEM [K]{u}={F} AND REPORT THE RESULTS IN THE SCREEN C
- C AND THE OUTPUT FILE C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- write (*,522) numdof,maxban
- 522 format (/' Solving the system [K]{u}={F}...'/' Number of degrees',
- + ' of freedom :',i5,' Bandwidth :'i4//
- + ' PASS 1 : FORWARD ELIMINATION')
- i1=1+numdof/80
- j1=numdof/i1-2
- k1=78-j1
- dash='-'
- arrow=''
- write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
- 524 format (1x,80a1)
- C
- C Calculate displacements
- C
- longi=-malhbw-1
- DO 535 I=1,numdof
- if (nextid(i,i1) .eq. 1) call pacer
- longi=longi+malhbw+2
- IF (igndof(I) .le. 0) then
- IF (ABS(stmtrx(longi)) .LT. .000001) THEN
- i1=(i-1)/3+1
- j1=i-3*(i1-1)
- WRITE (*,525) i1,j1
- 525 FORMAT (//' ERROR : THE STIFFNESS MATRIX APPEARS TO BE',
- + ' SINGULAR.'/' The elements connected to node ',i3
- + ,' do not contribute any stiffness in the free'/
- + ' degree of freedom ',i1,'.'/)
- call diskroom (162)
- WRITE (2,525,err=2000) i1,j1
- goto 994
- endif
- DO 530 J=1,lenhbw(I)-1
- l=i+j
- IF ((igndof(l) .le. 0) .and. (stmtrx(longi+j) .ne. 0.)) then
- RATIO=stmtrx(longi+j)/stmtrx(longi)
- longl=(malhbw+2)*j+longi-1
- DO 529 k=j+1,lenhbw(I)
- longl=longl+1
- IF (igndof(l) .le. 0) stmtrx(longl)=stmtrx(longl)-
- + ratio*stmtrx(longi-1+k)
- 529 CONTINUE
- stmtrx(longi+j)=ratio
- disdof(l)=disdof(l)-RATIO*disdof(I)
- endif
- 530 CONTINUE
- disdof(i)=disdof(i)/stmtrx(longi)
- ENDIF
- 535 CONTINUE
- write (*,536)
- 536 format (/' PASS 2 : BACKWARDS SUBSTITUTION')
- write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
- if (nextid(numdof,i1) .eq. 1) call pacer
- DO 550 i=numdof-1,1,-1
- if (nextid(i,i1) .eq. 1) call pacer
- longj=(malhbw+2)*(i-1)+1
- IF (igndof(i) .le. 0) then
- DO 540 K=1,lenhbw(i)-1
- 540 disdof(i)=disdof(i)-stmtrx(longj+k)*disdof(i+k)
- endif
- 550 CONTINUE
- write (*,555)
- 555 format (/' The system has been succesfully solved.')
- C
- C Print displacements
- C
- if (scrflg .eq. 0) then
- diamsg='Writing results to file
- + '
- call setstr (110,diamsg)
- call setstr (78,outfil)
- call movstr (diamsg,25,1,outfil,1,77)
- call resstr (outfil)
- call pakstr (diamsg)
- call constr (diamsg,elipss)
- call expstr (diamsg)
- call resstr (diamsg)
- write (*,680) diamsg
- 680 format (/1X,A/' Displacements...'\)
- endif
- if (scrflg .eq. 1) THEN
- WRITE (*,685)
- 685 FORMAT (//' NODE DISPLACEMENTS'//
- + ' Node U V Omega'/)
- endif
- call diskroom (76)
- WRITE (2,685,err=2000)
- DO 700 J=1,nnodes
- if (mxndif(j) .ne. 0) then
- if (scrflg .eq. 1) WRITE (*,690) j,(disdof(3*(j-1)+i),i=1,3)
- 690 FORMAT (I5,1X,3F12.6)
- call diskroom (44)
- WRITE (2,690,err=2000) j,(disdof(3*(j-1)+i),i=1,3)
- endif
- 700 CONTINUE
- C
- C Beam corner forces
- C
- IF (nbeams .gt. 0) then
- if (scrflg .eq. 1) then
- WRITE (*,710)
- 710 FORMAT (//' BEAM CORNER FORCES'//
- + ' Beam I J FX1 FY1 MZ1',
- + ' FX2 FY2 MZ2'/)
- else
- if (scrflg .eq. 0) write (*,205)
- endif
- call diskroom (125)
- WRITE (2,710,err=2000)
- DO 740 i=1,nbeams
- mat=matcbm(i)
- eyoung=youngm(mat)
- if ((eyoung .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
- n1=nodebm(1,i)
- n2=nodebm(2,i)
- diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
- diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
- blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+
- + diffnc(2,2)*diffnc(2,2))
- bmlcos=diffnc(1,2)/blngth
- bmlsin=diffnc(2,2)/blngth
- I1=3*n1-2
- j1=3*n2-2
- ftcons(1)=disdof(J1)-disdof(I1)
- ftcons(2)=disdof(J1+1)-disdof(I1+1)
- ftcons(3)=3*(bmlsin*ftcons(1)-bmlcos*ftcons(2))/blngth
- ftcons(4)=(bmdis1(i)+bmdis2(i))*blngth/2.
- ftcons(5)=2*eyoung*bminer(i)/blngth
- ftcons(6)=eyoung*bmarea(i)*(bmlcos*ftcons(1)+
- + bmlsin*ftcons(2))/blngth
- beamcf(3,1)=ftcons(5)*(ftcons(3)+2*disdof(I1+2)+
- + disdof(J1+2))-(8.*ftcons(4)-bmdis2(i)*
- + blngth/2.)*blngth/90.
- beamcf(3,2)=ftcons(5)*(2*disdof(J1+2)+disdof(I1+2)+
- + ftcons(3))+(8.*ftcons(4)-bmdis1(i)*
- + blngth/2.)*blngth/90.
- ftcons(7)=(ftcons(4)+bmdis1(i)*blngth/2.)/3.-
- + (beamcf(3,1)+beamcf(3,2))/blngth
- ftcons(8)=ftcons(7)-ftcons(4)
- beamcf(1,1)=-bmlcos*ftcons(6)+bmlsin*ftcons(7)
- beamcf(1,2)=bmlcos*ftcons(6)-bmlsin*ftcons(8)
- beamcf(2,1)=-bmlsin*ftcons(6)-bmlcos*ftcons(7)
- beamcf(2,2)=bmlsin*ftcons(6)+bmlcos*ftcons(8)
- DO 720 j=1,2
- DO 720 k=1,3
- reafor(k,nodebm(j,i))=reafor(k,nodebm(j,i))+beamcf(k,j)
- 720 CONTINUE
- baxial(i)=ftcons(6)
- bshear(1,i)=ftcons(7)
- bshear(2,i)=ftcons(8)
- bmomnt(1,i)=-beamcf(3,1)
- bmomnt(2,i)=beamcf(3,2)
- if (scrflg .eq. 1) WRITE (*,730) i,n1,n2,
- + (beamcf(k,1),k=1,3),(beamcf(k,2),k=1,3)
- 730 FORMAT (I5,2I6,1X,6F12.0)
- call diskroom (92)
- WRITE (2,730,err=2000) i,n1,n2,(beamcf(k,1),k=1,3),
- + (beamcf(k,2),k=1,3)
- endif
- 740 CONTINUE
- C
- C Beam loads and stresses
- C
- if (scrflg .eq. 1) WRITE (*,750)
- 750 FORMAT (//' BEAM LOADS AND STRESSES'//
- + ' Beam I J PAX SAX ',
- + 'SH1 SH2 BM1 BM2'/)
- call diskroom (130)
- WRITE (2,750,err=2000)
- DO 760 i=1,nbeams
- mat=matcbm(i)
- if ((youngm(mat) .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
- ftcons(1)=baxial(i)/bmarea(i)
- if (scrflg .eq. 1) WRITE (*,730) i,(nodebm(k,i),k=1,2),
- + baxial(i),ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
- call diskroom (92)
- WRITE (2,730,err=2000) i,(nodebm(k,i),k=1,2),baxial(i),
- + ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
- endif
- 760 continue
- endif
- C
- C Plate corner forces
- C
- IF (nplate .gt. 0) then
- if (scrflg .eq. 1) then
- WRITE (*,770)
- 770 FORMAT (//' PLATE CORNER FORCES'//
- + ' Plate I J K L FX1 FY1 ',
- + 'FX2 FY2 FX3 FY3 FX4 FY4'/)
- else
- if (scrflg .eq. 0) write (*,245)
- endif
- call diskroom (138)
- WRITE (2,770,err=2000)
- DO 850 LPL=1,nplate
- TH=plteth(LPL)
- mat=matcpl(lpl)
- eyoung=youngm(mat)
- pratio=poisson(mat)
- if ((th .ne. 0.) .and. (eyoung .ne. 0.)) then
- DO 780 I=1,2
- DO 780 J=1,4
- 780 pltecf(I,J)=0.
- IF (nodepl(4,LPL) .EQ. 0) THEN
- CALL triloads (1,2,3,th,eyoung,pratio,lpl,nodepl)
- ELSE
- coonod(1,nnodes+1)=(coonod(1,nodepl(1,LPL))+
- + coonod(1,nodepl(2,LPL))+coonod(1,nodepl(3,LPL))+
- + coonod(1,nodepl(4,LPL)))/4
- coonod(2,nnodes+1)=(coonod(2,nodepl(1,LPL))+
- + coonod(2,nodepl(2,LPL))+coonod(2,nodepl(3,LPL))+
- + coonod(2,nodepl(4,LPL)))/4
- ftcons(7)=0
- ftcons(8)=0
- ftcons(9)=0
- DO 790 i=1,8
- DO 790 J=1,2
- 790 sttemp(i,j)=0.
- inp(3)=nnodes+1
- DO 810 I=1,4
- J=nextid(I,4)
- inp(1)=nodepl(I,LPL)
- inp(2)=nodepl(J,LPL)
- DO 800 N1=1,2
- DO 800 N2=1,3
- 800 diffnc(N1,N2)=coonod(N1,inp(N2))-
- + coonod(N1,inp(previd(N2,3)))
- ftcons(1)=diffnc(2,3)*diffnc(1,2)-
- + diffnc(1,3)*diffnc(2,2)
- ftcons(2)=1/(ftcons(1)*(1+pratio))
- ftcons(3)=ftcons(2)*(diffnc(1,3)*diffnc(1,2)+
- + diffnc(2,3)*diffnc(2,2))
- ftcons(4)=ftcons(2)*(diffnc(2,3)*diffnc(1,2)-
- + diffnc(1,3)*diffnc(2,2))
- ftcons(5)=ftcons(2)*(diffnc(1,2)*diffnc(1,2)+
- + diffnc(2,2)*diffnc(2,2))
- ftcons(6)=1/(ftcons(1)*(1-pratio))
- sttemp(2*i-1,1)=sttemp(2*I-1,1)+ftcons(3)+
- + ftcons(6)*diffnc(2,2)*diffnc(2,3)
- sttemp(2*i-1,2)=sttemp(2*I-1,2)+ftcons(4)-
- + ftcons(6)*diffnc(2,3)*diffnc(1,2)
- sttemp(2*i,1)=sttemp(2*I,1)-ftcons(4)-
- + ftcons(6)*diffnc(2,2)*diffnc(1,3)
- sttemp(2*i,2)=sttemp(2*I,2)+ftcons(3)+
- + ftcons(6)*diffnc(1,3)*diffnc(1,2)
- sttemp(2*j-1,1)=sttemp(2*J-1,1)-ftcons(3)-ftcons(5)+
- + ftcons(6)*diffnc(2,2)*diffnc(2,1)
- sttemp(2*j-1,2)=sttemp(2*J-1,2)-ftcons(4)-
- + ftcons(6)*diffnc(2,1)*diffnc(1,2)
- sttemp(2*J,1)=sttemp(2*J,1)+ftcons(4)-
- + ftcons(6)*diffnc(2,2)*diffnc(1,1)
- sttemp(2*J,2)=sttemp(2*J,2)-ftcons(3)-ftcons(5)+
- + ftcons(6)*diffnc(1,1)*diffnc(1,2)
- ftcons(7)=ftcons(7)+ftcons(5)+
- + ftcons(6)*diffnc(2,2)*diffnc(2,2)
- ftcons(8)=ftcons(8)-
- + ftcons(6)*diffnc(1,2)*diffnc(2,2)
- ftcons(9)=ftcons(9)+ftcons(5)+
- + ftcons(6)*diffnc(1,2)*diffnc(1,2)
- 810 CONTINUE
- ftcons(1)=0
- ftcons(2)=0
- DO 820 I=1,4
- ftcons(1)=ftcons(1)-
- + sttemp(2*I-1,1)*disdof(3*nodepl(I,LPL)-2)-
- + sttemp(2*I,1)*disdof(3*nodepl(I,LPL)-1)
- ftcons(2)=ftcons(2)-
- + sttemp(2*I-1,2)*disdof(3*nodepl(I,LPL)-2)-
- + sttemp(2*I,2)*disdof(3*nodepl(I,LPL)-1)
- 820 CONTINUE
- ftcons(3)=ftcons(7)*ftcons(9)-ftcons(8)*ftcons(8)
- disdof(numdof+1)=(ftcons(1)*ftcons(9)-
- + ftcons(8)*ftcons(2))/ftcons(3)
- disdof(numdof+2)=(ftcons(2)*ftcons(7)-
- + ftcons(8)*ftcons(1))/ftcons(3)
- i=-nnodes-1
- CALL triloads (1,2,i,th,eyoung,pratio,lpl,nodepl)
- CALL triloads (2,3,i,th,eyoung,pratio,lpl,nodepl)
- CALL triloads (3,4,i,th,eyoung,pratio,lpl,nodepl)
- CALL triloads (4,1,i,th,eyoung,pratio,lpl,nodepl)
- DO 830 I=1,3
- 830 plstrs(I,LPL)=plstrs(I,LPL)/4
- ENDIF
- if (scrflg .eq. 1) WRITE (*,840) LPL,(nodepl(k,LPL),k=1,4)
- + ,((pltecf(i,j),i=1,2),j=1,4)
- 840 FORMAT (I5,4I6,1X,8F9.0)
- call diskroom (104)
- WRITE (2,840,err=2000) LPL,(nodepl(k,LPL),k=1,4),
- + ((pltecf(i,j),i=1,2),j=1,4)
- endif
- 850 CONTINUE
- C
- C Plate load-intensities and stresses
- C
- if (scrflg .eq. 1) WRITE (*,860)
- 860 FORMAT (//' PLATE LOAD INTENSITIES AND STRESSES'//
- + ' Plate I J K L PIX PIY TXY',
- + ' SX SY TAU SMAX SMIN TMAX',
- + ' Angle'/)
- call diskroom (172)
- WRITE (2,860,err=2000)
- DO 890 LPL=1,nplate
- mat=matcpl(lpl)
- if ((plteth(lpl) .ne. 0.) .and. (youngm(mat) .ne. 0.)) then
- DO 870 I=1,3
- 870 plints(I)=plstrs(I,LPL)*plteth(LPL)
- ftcons(3)=SQRT(plstrs(3,LPL)*plstrs(3,LPL)+
- + .25*(plstrs(2,LPL)-plstrs(1,LPL))*(plstrs(2,LPL)-
- + plstrs(1,LPL)))
- ftcons(5)=.5*(plstrs(1,LPL)+plstrs(2,LPL))
- ftcons(1)=ftcons(5)+ftcons(3)
- ftcons(2)=ftcons(5)-ftcons(3)
- ftcons(4)=degree(2*plstrs(3,LPL),
- + plstrs(2,LPL)-plstrs(1,LPL))/2.
- if (scrflg .eq. 1) WRITE (*,880) LPL,(nodepl(k,LPL),k=1,4)
- + ,(plints(k),k=1,3),(plstrs(k,LPL),k=1,3)
- + ,(ftcons(k),k=1,4)
- 880 FORMAT (I5,4I6,1X,10F9.0)
- call diskroom (122)
- WRITE (2,880,err=2000) LPL,(nodepl(k,LPL),k=1,4),
- + (plints(k),k=1,3),(plstrs(k,LPL),k=1,3),(ftcons(k),k=1,4)
- endif
- 890 CONTINUE
- C
- C Plate stresses at node points
- C
- if (scrflg .eq. 1) WRITE (*,900)
- 900 FORMAT (//' PLATE STRESSES AT NODE POINTS'//
- + ' Node Coordinate X Coordinate Y SX SY ',
- + ' TAU SMAX SMIN TMAX Angle'/)
- call diskroom (151)
- WRITE (2,900,err=2000)
- DO 930 I=1,nnodes
- k=0
- DO 910 J=1,3
- IF (pstnor(J,I) .GT. 0.) THEN
- ftcons(J)=pstacc(J,I)/pstnor(J,I)
- ELSE
- k=1
- ENDIF
- 910 CONTINUE
- if (k .ne. 1) then
- ftcons(6)=SQRT(ftcons(3)*ftcons(3)+
- + .25*(ftcons(2)-ftcons(1))*(ftcons(2)-ftcons(1)))
- ftcons(8)=.5*(ftcons(1)+ftcons(2))
- ftcons(4)=ftcons(8)+ftcons(6)
- ftcons(5)=ftcons(8)-ftcons(6)
- ftcons(7)=degree(sngl(2*ftcons(3)),
- + sngl(ftcons(2)-ftcons(1)))/2.
- if (scrflg .eq. 1) WRITE (*,920) I,coonod(1,I),coonod(2,I)
- + ,(ftcons(k),k=1,7)
- 920 FORMAT (I5,3X,F12.5,3X,F12.5,7F10.0)
- call diskroom (107)
- WRITE (2,920,err=2000) I,coonod(1,I),coonod(2,I),
- + (ftcons(k),k=1,7)
- endif
- 930 CONTINUE
- endif
- C
- C Fastener forces and stresses
- C
- IF (nfastn .gt. 0) then
- if (scrflg .eq. 1) then
- WRITE (*,940)
- 940 FORMAT (//' FASTENER FORCES AND STRESSES'//
- + ' Fastener I J FX FY F ',
- + 'Angle Stress'/)
- else
- if (scrflg .eq. 0) write (*,385)
- endif
- call diskroom (113)
- WRITE (2,940,err=2000)
- DO 960 LFS=1,nfastn
- if (fsstif(lfs) .ne. 0.) then
- n1=nodefs(1,LFS)
- n2=nodefs(2,LFS)
- I1=3*n1-2
- J1=3*n2-2
- ftcons(1)=fsstif(lfs)*(disdof(I1)-disdof(J1))
- ftcons(2)=fsstif(lfs)*(disdof(I1+1)-disdof(J1+1))
- ftcons(3)=SQRT(ftcons(1)*ftcons(1)+ftcons(2)*ftcons(2))
- ftcons(4)=degree(sngl(ftcons(2)),sngl(ftcons(1)))
- ftcons(5)=ftcons(3)/fsarea(lfs)
- if (scrflg .eq. 1) WRITE (*,950) LFS,n1,n2,
- + (ftcons(k),k=1,5)
- 950 FORMAT (I5,2I6,1X,5F10.0)
- call diskroom (70)
- WRITE (2,950,err=2000) LFS,n1,n2,(ftcons(k),k=1,5)
- reafor(1,n1)=reafor(1,n1)+ftcons(1)
- reafor(1,n2)=reafor(1,n2)-ftcons(1)
- reafor(2,n1)=reafor(2,n1)+ftcons(2)
- reafor(2,n2)=reafor(2,n2)-ftcons(2)
- endif
- 960 CONTINUE
- endif
- C
- C Node internal forces and reactions
- C
- reaclb(1)=' '
- reaclb(2)=' '
- reaclb(3)='Reaction'
- if (scrflg .eq. 1) then
- WRITE (*,970)
- 970 FORMAT (//' NODE INTERNAL FORCES AND REACTIONS'//
- + ' Node Coordinate X Coordinate Y FX',
- + ' FY MZ'/)
- else
- if (scrflg .eq. 0) write (*,972)
- 972 format ('Reactions...'\)
- endif
- call diskroom (142)
- WRITE (2,970,err=2000)
- DO 990 I=1,nnodes
- if (scrflg .eq. 1) WRITE (*,980) I,coonod(1,I),coonod(2,I),
- + (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
- 980 FORMAT (I5,3X,F12.5,3X,F12.5,3(F12.0,1x,a8,1x))
- call diskroom (103)
- WRITE (2,980,err=2000) I,coonod(1,I),coonod(2,I),
- + (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
- 990 CONTINUE
- if (scrflg .eq. 0) write (*,512)
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C REPORT THE EXECUTION TIME C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C
- C Report the execution time
- C
- 994 cpusec=0.
- call time (lasthr,lastmn,lastsc,lasths)
- if (lasthr .lt. inithr) cpusec=86400.
- cpusec=cpusec+3600.*(lasthr-inithr)+60.*(lastmn-initmn)+lastsc-
- + initsc+.01*(lasths-iniths)
- if (scrflg .ge. 0) write (*,995) cpusec
- 995 format (//' Execution time : ',f8.2,' seconds.')
- if (ierror .ne. -1) then
- call diskroom (43)
- write (2,995,err=2000) cpusec
- endif
- write (*,999)
- 999 format (' ')
- STOP
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- C C
- C REPORT UNSPECIFIED I/O ERRORS DETECTED C
- C C
- CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
- 1000 write (*,1010)
- 1010 format (//' ERROR : CANNOT READ INPUT FILE.'/
- + ' The program cannot continue.')
- goto 994
- 2000 write (*,2010)
- 2010 format (//' ERROR : CANNOT WRITE OUTPUT FILE.'/
- + ' The program cannot continue.')
- ierror=-1
- goto 994
- END
-